#
# tpycl.tcl is the tcl support code to allow calling of python-wrapped
# vtk code from tcl scripts.
#
# all support code is in the ::tpycl namespace
#
# to the extent possible this code emulates vtk's tcl wrapping so no
# source modification is required in the scripts
#

if { [info command ::tpycl::tcl_package] == "" } {
  # rename the 'package' command first time script is sourced
  rename ::package ::tpycl::tcl_package
}

proc ::package {option args} {
  # special purpose version of the package command to import vtk
  # - not really general pupose - scripts that make extensive use of tpycl
  #   should be aware of things they want to get from python and
  #   call py_package directly
  if { $option == "require" && $args == "vtk" } {
    py_package vtk
    return [string range [py_eval "vtk.vtkVersion().GetVTKVersion()"] 1 end-1]
  } else {
    return [eval ::tpycl::tcl_package $option $args]
  }
}

if { [info command ::tpycl::tcl_puts] == "" } {
  # rename the 'puts' command first time script is sourced
  rename ::puts ::tpycl::tcl_puts
}

proc puts {args} {
  if { $args == "" } {
    error "wrong # args: should be \"puts ?-nonewline? ?channelId? string\""
  }
  set noNewline 0
  if { [lindex $args 0] == "-nonewline" } {
    set noNewline 1
    set args [lrange $args 1 end]
  }
  py_puts $noNewline $args
}


if { [info command ::tpycl::tcl_after] == "" } {
  # rename the 'after' command first time script is sourced
  rename ::after ::tpycl::tcl_after
}

set ::after_serial -1
array set ::after_scripts {}
proc ::after {option args} {
  switch $option {
    "cancel" {
      if { [scan $args after#%d serial] != 1 } {
        error "can't parse $args"
      }
      if { [info exists ::after_scripts(idle,$serial)] } {
        unset ::after_scripts(idle,$serial)
      } else {
        # silent error condition - mimic tcl native behavior
        # error "No after event $serial"
      }
      set returnValue "" 
    }
    "idle" {
      incr ::after_serial
      set ::after_scripts(idle,$::after_serial) $args
      set returnValue "after#$::after_serial"
    }
    default {
      if { ![string is integer $option] } {
        error "expected integer but got $option"
      }
      # TODO: this currently is the same as 'idle' - needs to be changed to respect the ms argument
      incr ::after_serial
      set ::after_scripts(idle,$::after_serial) $args
      set returnValue "after#$::after_serial"
    }
  }
  if { [array names ::after_scripts idle,*] != "" } {
    # we have scripts to process, so tell pythonqt to start the timer
    py_after    
  }
  return $returnValue
}

proc ::after_callback {} {
  set idleScripts [array names ::after_scripts idle,*]
  foreach script $idleScripts {
    # check if script exists - it might have been canceled during
    # one of the earlier callbacks
    if { [info exists ::after_scripts($script)] } {
      eval $::after_scripts($script)
      unset ::after_scripts($script)
    }
  }
  if { [array names ::after_scripts idle,*] != "" } {
    # we have more scripts to process, so tell pythonqt to start the timer
    py_after
  }
}
  
namespace eval tpycl {

  proc registerClass {className pyConstructor} {
    # create a proc in the global namespace that acts as the 
    # instantiator for the given class (this is called from the python
    # code for each class imported from the module)
    proc ::$className {args} [format "tpycl::instantiator $className $pyConstructor $%s" args]
  }

  proc uniqueInstanceName { className } {
    # make a unique command name
    # Not a super-efficient way, but workable:
    for {set i 0} {$i > -1} {incr i} {
      set instanceName $className$i
      if { [info command $instanceName] == "" } {
        break
      }
    }
    return $instanceName
  }

  proc instantiator {className pyConstructor arg} {
    # this will create a new instance of the class with the given name
    # and acts pretty much just like the vtk wrapping
    switch $arg {
      "ListInstances" {
        # does not account for non-autogenerated classes
        return [info command $className0x*]
      }
      "New" {
        set instanceName [tpycl::uniqueInstanceName $className]
      }
      default {
        set instanceName $arg
      }
    }
    # call the constructor - py_eval automatically 
    # creates an instance wrapper based on the classname
    # and the pointer
    set pyInstanceName [py_eval "$pyConstructor\(\)"]
    if { $arg == "New" } {
      set instanceName $pyInstanceName
    } else {
      # if the caller specified a name, create an alias proc for it
      proc ::$instanceName {args} [format "tpycl::methodCaller $instanceName $pyInstanceName $%s" args]
    }
    return $instanceName
  }

  proc methodCaller {tclInstanceName pyInstanceName args} {
    # call to python to execute the method for this instance
    set args [lindex $args 0]
    set method [lindex $args 0]
    set args [lrange $args 1 end]

    if { $args == "{}" || $args == "\"\"" } {
      set args "''"
    }

    # construct a python command with the args
    # TODO: deal with special cases in a more general way
    switch $method {
      "Print" {
        set pycmd "str($pyInstanceName)"
      }
      "IsA" {
        set fmt "$pyInstanceName.IsA('%s')"
        set pycmd [eval format $fmt $args]
      } 
      "Delete" {
        py_del "$pyInstanceName"
        
        if { [info procs ::$pyInstanceName] != "" } {
          rename ::$pyInstanceName ""
        }
        if { [info procs ::$tclInstanceName] != "" } {
          rename ::$tclInstanceName ""
        }
        return
      } 


      default {
        set doc [py_eval "__tmpdoc = $pyInstanceName.$method.__doc__"]
        set types [py_eval "__tmpdoc\[__tmpdoc.find('(')+1:__tmpdoc.find(')')\]"]

        set tuple 0
        if { [string range $types 0 1] == "'(" } {
          # TODO: need more robust type parsing
          set tuple 1
        }
        
        set isArray 0
        if { [string range $types 0 1] == "'\[" } {
          # TODO: need more robust type parsing
          set isArray 1
        }

        if { $types == "''" } {
          set types ""
        }
        if { [llength $args] != [llength $types] } {
          # TODO: check for non matching args here
          # - complication is multiple sinatures
          # error "$pyInstanceName $method called with \"$args\" but method needs \"$types\" (according to $doc)"
        }

        # avoid trying to set "$var(" as tcl will 
        # try to treat it as an array reference
        set pycmd [format "$pyInstanceName.$method%s" "("]
        foreach arg $args { 
          set type [lindex $types 0]
          set types [lrange $types 1 end]
          if { [string match "'vtk*" $type] && ($arg == "" || $arg == "''")  } {
            # if it's a vtk object, python wants None, not empty string
            set arg "None"
          } else {
            if { ![py_type $arg] } {
              # python doesn't understand the argument, and we don't know what type it is,
              # so assume it is a string
              if { $arg != "" } {
                set arg '$arg'
              }
            }
            if { [string match "string*" $type] } {
              set arg "str($arg)"
            }
            if { [string match "*int*" $type] && ($arg == "" || $arg == "''") } {
              set arg 0
            }
            if { [string match "*float*" $type] && ($arg == "" || $arg == "''") } {
              set arg 0.
            }
          }
          if { ([string index $pycmd end] != "(") && ([string index $pycmd end] != "\[") } {
            # if not at start of arg list, add a comma
            set pycmd "$pycmd,"
          } else {
            if { $tuple } {
              # append a paren but don't look like an array while doing it
              set pycmd [format "$pycmd%s" "("]
            }
            if { $isArray } {
              # Append a 'open bracket'
              set pycmd [format "$pycmd%s" "\["]
            }
          }
          set pycmd "$pycmd$arg"
        }
        if { $args != "" } {
          if { $tuple } {
            set pycmd "$pycmd)"
          }
          if { $isArray } {
            set pycmd "$pycmd\]"
          }
        }
        set pycmd "$pycmd)"
      }
    }

    # escape any new lines
    regsub -all "\n" $pycmd "\\n" pycmd

    # execute the command
    set pyresult [py_eval $pycmd]
    if { $pyresult == "None" } {
      # if no return value, return nothing
      return
    }
    if [string match (*) $pyresult] {
      # if it's a tuple, strip the parens and make the commas into spaces
      # TODO: won't work for a tuple of strings with spaces in them
      regsub -all $pyresult , "" pyresult
      return [string range $pyresult 1 end-1]
    }
    if [string match '*' $pyresult] {
      # if it's a string, strip the quotes
      return [string range $pyresult 1 end-1]
    }
    if { [string index $pyresult end] == "L" && 
          [string is int [string range $pyresult 0 end-1]] } {
      # if it's a long int, return just the int part
      return [string range $pyresult 0 end-1]
    }
    # otherwise, it's probably a value or reference
    return $pyresult
  }

}


